perm filename FILL.FAI[NEW,LCS]3 blob
sn#153814 filedate 1975-04-09 generic text, type T, neo UTF8
TITLE FILL
ENTRY FILLER,LINES
DEFINE FLOAT(N)
< TLC N,232000
FADR N,N >
DEFINE FIXX(N)
< JUMPGE N,.+5
MOVNS N
FIX N,233000
MOVNS N
CAIA
FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
; SUBROUTINE FILLER(Q,M)
FILLER: 0
MOVEM 16,SV16#
HRRZ J,(16)
HRRZM J,SVQ#
HRRZ T,@1(16)
HRRZM T,SVM# ; KK=NE(1)
HRRZ KK,2(J)
ADDI KK,-1(J)
; DO 4 K=2,KK
HRRZI L,2(J)
; IF(NE(K).NE.3)GO TO 11
L4: ADDI L,3
HRRZ T,(L)
L11: SETZM (L)
CAIN T,3
; NE(K)=-1
SETOM (L)
; GO TO 4
; 11 NE(K)=0
; 4 CONTINUE
CAIGE L,(KK)
JRST L4
; RLFT=10000
MOVE RL,[=10000.0]
; RT=-10000
MOVN RJ,[=10000.0]
; B=RT
MOVE B,RJ
; DO 12 K=1,KK
HRRZI L,-3(J)
; H=IFIX(Q(K))
L12: ADDI L,3
MOVE H,(L)
FIXX(H)
FLOAT(H)
; IF(H.LT.RLFT)RLFT=H
CAMGE H,RL
MOVE RL,H
; IF(H.GT.RT)RT=H
CAMLE H,RJ
MOVE RJ,H
; IF(H.EQ.B)NE(K)=-1
CAMN H,B
SETOM 2(L)
; B=H
MOVE B,H
; Q(K)=H
MOVEM H,(L)
; 12 R(K)=IFIX(R(K))
MOVE T,1(L)
FIXX(T)
FLOAT(T)
MOVEM T,1(L)
CAIGE L,-2(KK)
JRST L12
; NE(KK+1)=-1
SETOM 3(KK)
; LRT=RT
FIXX(RJ)
MOVEM RJ,LRT#
; JA=3
HRRZI T,3
HRRZM T,JA#
; 124 LEFT=RLFT
L124: MOVE LE,RL
FIXX(LE)
; 51 J=LEFT
L51: MOVE J,LE
; 42 RJ=J+.001
L42: MOVE RJ,J
FLOAT(RJ)
FADR RJ,[=0.001]
; JCONT=0
SETZM JCONT#
; LEFT=J
MOVE LE,J
; JJ=-1
SETO JJ,
; ALT=-10000.
MOVN AL,[=10000.0]
; 200 DO 45 L=2,KK
HRRZ L,SVQ
L45: ADDI L,3
CAILE L,-2(KK)
JRST L455
; IF(NE(L).NE.0)GO TO 45
SKIPE 2(L)
JRST L45
; IF(MISS(L,RJ,Q))GO TO 45
CAML RJ,-3(L)
JRST L201
CAMLE RJ,(L)
JRST L202
L201: CAMGE RJ,(L)
CAMG RJ,-3(L)
JRST L45
; H=HGHT(L,RJ,Q,R)
L202: MOVE H,-2(L)
CAMN H,1(L)
JRST RET
MOVNS H
FADR H,1(L)
MOVE D,-3(L)
MOVNS T,D
FADR T,RJ
FADR D,(L)
FMPR H,T
FDVR H,D
FADR H,-2(L)
; IF(H.LT.ALT)GO TO 45
RET: CAMGE H,AL
JRST L45
; ALT=H
MOVE AL,H
; JJ=L
HRRZI JJ,(L)
; 45 CONTINUE
JRST L45
; IF(JJ)GO TO 43
L455: JUMPL JJ,L43
; JCONT=-1
SETOM JCONT
; LEFT=J
MOVE LE,J
; 46 JA=3
L46: HRRZI T,3
HRRZM T,JA
; JORD=-1
SETOM JORD#
; 52 KN=Q(JJ)
L52: MOVE T,(JJ)
FIXX(T)
MOVEM T,KN#
; KL=Q(JJ-1)
MOVE T,-3(JJ)
FIXX(T)
MOVEM T,KL#
; IF(KN.LT.KL)KN=KL
CAMLE T,KN
MOVEM T,KN
; 50 I=J
L50: MOVEM J,I#
; 102 RJ=I+.01
L102: MOVE RJ,I
FLOAT(RJ)
FADR RJ,[=0.01]
; ALT=HGHT(JJ,RJ,Q,R)
MOVE AL,-2(JJ)
CAMN AL,1(JJ)
JRST RET2
MOVNS AL
FADR AL,1(JJ)
MOVE D,-3(JJ)
MOVNS T,D
FADR T,RJ
FADR D,(JJ)
FMPR AL,T
FDVR AL,D
FADR AL,-2(JJ)
; B=-10000
RET2: MOVN B,[=10000.0]
; JK=-1
SETO JK,
; XALT=ALT+.001
MOVE T,AL
FADR T,[=0.001]
MOVEM T,XALT#
; ZALT=ALT
MOVEM AL,ZALT#
; 400 DO 47 L=2,KK
MOVE L,SVQ
L47: ADDI L,3
CAILE L,-2(KK)
JRST L477
; IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
CAME L,JJ
SKIPGE 2(L)
JRST L47
CAML RJ,-3(L)
JRST L475
CAMLE RJ,(L)
JRST L476
L475: CAMGE RJ,(L)
CAMG RJ,-3(L)
JRST L47
; H=HGHT(L,RJ,Q,R)
L476: MOVE H,-2(L)
CAMN H,1(L)
JRST RET3
MOVNS H
FADR H,1(L)
MOVE D,-3(L)
MOVNS T,D
FADR T,RJ
FADR D,(L)
FMPR H,T
FDVR H,D
FADR H,-2(L)
; IF(H.GT.XALT)GO TO 47
RET3: CAMG H,XALT
; IF(H.LE.B)GO TO 47
CAMG H,B
JRST L47
; B=H
MOVE B,H
; JK=L
HRRZI JK,(L)
; 47 CONTINUE
JRST L47
; IF(JK)GO TO 48
L477: JUMPL JK,L48
; 300 IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
MOVN T,B
FADR T,ZALT
CAMG T,[=0.001]
CAME J,I
JRST L59
; JX=Q(JK)
MOVE T,(JK)
FIXX(T)
; IF(JX.GT.KN)GO TO 60
CAMLE T,KN
JRST L60
; JX=Q(JK-1)
MOVE T,-3(JK)
FIXX(T)
; IF(JX.LT.KN)GO TO 59
CAMGE T,KN
JRST L59
; 60 L=JJ
L60: MOVE L,JJ
; JJ=JK
MOVE JJ,JK
; JK=L
MOVE JK,L
; KN=JX
MOVEM T,KN
; 59 IF(ALT-B.LT.2)GO TO 62
L59: MOVN T,B
FADR T,AL
CAMGE T,[=2.0]
JRST L62
; ALT=ALT-1
HRLZI T,576400
FADR AL,T
; B=B+1
HRLZI T,201400
FADR B,T
; 62 IF(JORD)GO TO 103
L62: SKIPGE JORD
JRST L103
; H=B
MOVE H,B
; B=ALT
MOVE B,AL
; ALT=H
MOVE AL,H
; IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
CAMN JK,NK#
JRST L103
MOVN T,B
FADR T,AL
SKIPGE T
MOVNS T
CAMG T,[5.0]
JRST L103
HRRZI T,3
HRRZM T,JA
; 103 CALL LINES(RJ,ALT,JA)
L103: MOVEM RJ,SVRJ#
MOVEM AL,SVAL#
MOVEM B,SVB#
HRRZI 16,SVAC
BLT 16,SVAC+15
JSA 16,LINES
JUMP SVRJ
JUMP SVAL
JUMP JA
; 100 CALL LINES(RJ,B,2)
JSA 16,LINES
JUMP SVRJ
JUMP SVB
JUMP [2]
HRLZI 16,SVAC
BLT 16,15
; NK=JK
MOVEM JK,NK
; JORD=-JORD
MOVNS JORD
; NE(JK)=1
HRRZI T,1
HRRZM T,2(JK)
; NE(JJ)=-1
SETOM 2(JJ)
; JA=2
HRRZI T,2
HRRZM T,JA
; I=I+M
MOVE T,SVM
ADDB T,I
; IF(I.LT.KN)GO TO 102
CAMGE T,KN
JRST L102
; L=1
HRRZI L,3
; IF(KN.EQ.KL)L=-1
MOVE T,KN
CAMN T,KL
HRROI L,-3
; JJ=JJ+L
ADD JJ,L
; J=0
SETZ J,
; IF(L)J=-1
SKIPGE L
HRROI J,-3
; IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
SKIPN 2(JJ)
CAILE JJ,-2(KK)
JRST L124
ADD T,SVM
FLOAT(T)
HRRZI HG,(JJ)
ADD HG,J
CAMLE T,(HG)
JRST L124
; J=I
MOVE J,I
; GO TO 52
JRST L52
; 48 JA=3
L48: HRRZI T,3
HRRZM T,JA
; 43 J=LEFT+M
L43: MOVE J,LE
ADD J,SVM
; IF(J.LE.LRT)GO TO 42
CAMG J,LRT
JRST L42
; IF(JCONT)GO TO 51
SKIPGE JCONT
JRST L51 ; END
MOVE 16,SV16
JRA 16,2(16)
SVAC: BLOCK 16
EXTERNAL DST,SIZ,PLTR,DPY,AIVECT,AVECT,.COMM.
; SUBROUTINE LINES(A,B,L)
; COMMON/DST/BB,CC
; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
; 1,(JJ2,JJ(2))
; DATA BB/.008/,CC/3.5/
;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
M←2 ↔ N←3 ↔ K←4
LINES: 0
; GO TO 23
JRST L23
;22 IF(JQ(1).NE.0)GO TO 23
L22: SKIPE PLTR+=27
JRST L23
; IF(CC.EQ.1000)GO TO 23
MOVSI T,212764
CAMN T,DST+1
JRST L23
; B=B*(CC-BB*ABS(A))
MOVE T,@(16)
MOVM T,T
FMPR T,DST
FSBR T,DST+1
FMPRM T,@1(16)
MOVNS @1(16)
;23 IF(IPLT)GO TO 2
; M=A*RSZ
L23: MOVE M,@(16)
FMPR M,SIZ
FIXX(M)
; N=B*RSZ
MOVE N,@1(16)
FMPR N,SIZ
FIXX(N)
; IF(RSZ.LE.0.8571)GO TO 3
MOVE T,[=0.8571]
CAML T,SIZ
;; JRST L3
JRST L6
SUB M,SIZ+1 ; M=M-JCEN
SUB N,SIZ+2 ; N=N-KCEN
; IF(JA.NE.8)GO TO 5
MOVEI T,10
CAME T,.COMM.+1
JRST L5
; IF(M.GT.511)M=511
CAMLE M,[=511]
HRRZI M,=511
; IF(M.LT.-511)M=-511
CAMGE M,[-=511]
HRROI M,-=511
;5 IF(IABS(M).GT.512)GO TO 77
L5: CAIG M,=512
CAMGE M,[-=512]
JRST L77
; IF(IABS(N).LT.512)GO TO 4
CAIGE N,=512
CAMG N,[-=512]
CAIA
JRST LL4
;77 KZ=-1
L77: SETOM KZ#
; RETURN
JRA 16,3(16)
;4 IF(KZ.EQ.0)GO TO 6
LL4: SKIPN KZ
JRST L6
; KZ=0
SETZM KZ
MOVEM M,MM# ; GO TO 1
MOVEM N,NN#
JRST L1
;3 IF(JA.EQ.44)GO TO 6
;6 IF(JJ2.GT.3990)RETURN
L6: MOVEI T,7626
CAMGE T,DPY+1
JRA 16,3(16)
; IF(L.EQ.3)GO TO 1
MOVEM M,MM
MOVEM N,NN
HRRZI T,3
CAMN T,@2(16)
JRST L1
; CALL AVECT(M,N)
JSA 16,AVECT
JUMP MM
JUMP NN
; RETURN
JRA 16,3(16)
;1 CALL AIVECT(M,N)
L1: JSA 16,AIVECT
JUMP MM
JUMP NN
; RETURN
JRA 16,3(16)
;2 IF(IPLT.EQ.-2)RETURN
;;L2: MOVNI T,2
;; CAMN T,PLTR
;; JRA 16,3(16)
END